Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/cocktail/cg.lha/cg/src/c3.puma

Text File | 1992-11-24 | 14KB | 482 lines

/* Ich, Doktor Josef Grosch, Informatiker, 23.5.1989 */

TRAFO EvalC
TREE Tree
PUBLIC EvalDefC EvalImplC EvalImplHead GenEvaluator

EXPORT { VAR Class: Tree.tTree; }

GLOBAL {

FROM SYSTEM    IMPORT ADR;
FROM IO        IMPORT WriteS, WriteNl;
FROM StringMem    IMPORT Length, WriteString;
FROM Idents    IMPORT tIdent, GetStringRef;
FROM Texts    IMPORT WriteText;
FROM Sets    IMPORT IsElement;
FROM TreeC1    IMPORT BSS;
FROM TreeC2    IMPORT WriteLine;
FROM EvalC3    IMPORT ToBit0;

FROM Tree    IMPORT
   NoTree    , tTree        , Child        , ClassCount    ,
   Computed    , Reverse    , Write        , Read        ,
   Inherited    , Synthesized    , Input        , Output    ,
   Stack    , Variable    , NoCodeClass    ,
   CopyDef    , CopyUse    , Thread    , Virtual    ,
   Test        , Left        , Right        ,
   NonBaseComp    , First        , Dummy        , Trace        ,
   Options    , TreeRoot    , iModule    , iMain        ,
   itTree    , ForallClasses    , f        , WI    , WN    ,
   IdentifyClass, IdentifyAttribute, GrammarClass, cOAG        ,
   MaxVisit    ;

VAR
   n        : SHORTCARD;
   Node        ,
   Attr        ,
   ChildsClass    : tTree;
}

PROCEDURE EvalDefC (t: Tree)

Ag (..) :- {
    !# ifndef yy! WI (EvalName); !!
    !# define yy! WI (EvalName); !!
    !!
    !# if defined __STDC__ | defined __cplusplus!
    !# define ARGS(parameters)    parameters!
    !# else!
    !# define ARGS(parameters)    ()!
    !# endif!
    !!
    @# include "@ WI (iMain); @.h"@
    !!
    WriteLine (EvalCodes^.Codes.ImportLine);
    WriteText (f, EvalCodes^.Codes.Import);
    Node := Modules;
    WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.ImportLine);
       WriteText (f, Node^.Module.EvalCodes^.Codes.Import);
       Node := Node^.Module.Next;
    END;
    WriteLine (EvalCodes^.Codes.ExportLine);
    WriteText (f, EvalCodes^.Codes.Export);
    Node := Modules;
    WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.ExportLine);
       WriteText (f, Node^.Module.EvalCodes^.Codes.Export);
       Node := Node^.Module.Next;
    END;
    !!
    !extern void ! WI (EvalName); ! ARGS((! WI (itTree); ! yyt));!
    !extern void Begin! WI (EvalName); ! ();!
    !extern void Close! WI (EvalName); ! ();!
    !!
    !# endif!
}; .

PROCEDURE EvalImplHead (t: Tree)

Ag (..) :- {
    !# define DEP(a, b) a!
    !# define SELF yyt!
    @# include "@ WI (EvalName); @.h"@
      IF IsElement (ORD ('Y'), Options) OR
         IsElement (ORD ('Z'), Options) OR
         IsElement (ORD ('L'), Options) THEN
    @# include <stdio.h>@
      END;
      IF IsElement (ORD ('Y'), Options) OR
         IsElement (ORD ('Z'), Options) THEN
    !# ifdef __cplusplus!
    @extern "C" {@
    @# include "Idents.h"@
    @# include "Sets.h"@
    !}!
    !# else!
    @# include "Idents.h"@
    @# include "Sets.h"@
    !# endif!
      END;
      IF IsElement (ORD ('9'), Options) THEN
    !# ifdef __cplusplus!
    @extern "C" {@
    @# include "General.h"@
    !}!
    !# else!
    @# include "General.h"@
    !# endif!
    !!
    !static int xxStack;!
      END;
    WriteLine (EvalCodes^.Codes.GlobalLine);
    WriteText (f, EvalCodes^.Codes.Global);
    Node := Modules;
    WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.GlobalLine);
       WriteText (f, Node^.Module.EvalCodes^.Codes.Global);
       Node := Node^.Module.Next;
    END;
    !!
      IF IsElement (ORD ('X'), Options) THEN
    @# include "yy@ WI (iModule); @.w"@
    !# define yyWrite! WI (iMain); !(a) Write! WI (iMain); ! (yyf, a)!
      END;
    !!
    !static char yyb;!
      IF IsElement (ORD ('Y'), Options) OR
         IsElement (ORD ('Z'), Options) THEN
    !!
    !# define yyTrace    true!
    !!
    !static char * yyTypeName [! WN (ClassCount); ! + 1] = { 0,!
    ForallClasses (Classes, TypeName);
    !};!
    !!
    !static void yyWriteType!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt)!
    !# else!
    ! (yyt) ! WI (itTree); ! yyt;!
    !# endif!
    !{!
    ! char * yys = yyTypeName [yyt->Kind];!
    ! register int yyi = 16 - strlen (yys);!
    @ (void) printf ("%s", yys);@
    ! while (yyi -- > 0) (void) putc (' ', stdout);!
    !}!
      END;
      IF IsElement (ORD ('X'), Options) THEN
    !!
    !static FILE * yyf = stdout;!
    !!
    !static void yyWriteHex!
    !# if defined __STDC__ | defined __cplusplus!
    ! (unsigned char * yyx, int yysize)!
    !# else!
    ! (yyx, yysize) unsigned char * yyx; int yysize;!
    !# endif!
    @{ register int yyi; for (yyi = 0; yyi < yysize; yyi ++) (void) printf ("%02x ", yyx [yyi]); }@
    !!
    !static void yyWriteNl () { if (yyTrace) { (void) putc ('\n', stdout); (void) fflush (stdout); } }!
      END;
      IF IsElement (ORD ('X'), Options) THEN
    !!
    !static void yyWriteEval!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt, char * yys)!
    !# else!
    ! (yyt, yys) ! WI (itTree); ! yyt; char * yys;!
    !# endif!
    !{!
    ! if (yyTrace) {!
    !  register int yyi = 24 - strlen (yys);!
    !  yyWriteType (yyt);!
    @  (void) printf (" e %s", yys);@
    !  while (yyi -- > 0) (void) putc (' ', stdout);!
    @  (void) printf (" = ");@
    !  (void) fflush (stdout);!
    ! }!
    !}!
      ELSIF IsElement (ORD ('Y'), Options) THEN
    !!
    !static void yyWriteEval!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt, char * yys)!
    !# else!
    ! (yyt, yys) ! WI (itTree); ! yyt; char * yys;!
    !# endif!
    !{!
    ! if (yyTrace) {!
    !  yyWriteType (yyt);!
    @  (void) printf (" e %s\n", yys);@
    !  (void) fflush (stdout);!
    ! }!
    !}!
      END;
      IF IsElement (ORD ('Z'), Options) THEN
    !!
    !static void yyWriteVisit!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt, char * yys)!
    !# else!
    ! (yyt, yys) ! WI (itTree); ! yyt; char * yys;!
    !# endif!
    !{!
    ! if (yyTrace) {!
    !  yyWriteType (yyt);!
    @  (void) printf (" v %s\n", yys);@
    !  (void) fflush (stdout);!
    ! }!
    !}!
    !!
    !static void yyVisitParent!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt)!
    !# else!
    ! (yyt) ! WI (itTree); ! yyt;!
    !# endif!
    @{ yyWriteVisit (yyt, "parent"); }@
      END;
}; .

PROCEDURE EvalImplC (t: Tree)

Ag (..) :- {
    EvalImplHead (t);
    !!
    FOR n := 1 TO MaxVisit DO
       !static void yyVisit! WN (n); ! ARGS((register ! WI (itTree); ! yyt));!
    END;
    !!
    !void ! WI (EvalName); !!
    !# if defined __STDC__ | defined __cplusplus!
    ! (! WI (itTree); ! yyt)!
    !# else!
    ! (yyt) ! WI (itTree); ! yyt;!
    !# endif!
      IF NOT IsElement (ORD ('9'), Options) THEN
    !{ ! IF MaxVisit > 0 THEN !yyVisit1 (yyt); ! END; !}!
      ELSE
    !{!
    ! char xxHigh;!
    ! xxStack = 1000000000;!
    IF MaxVisit > 0 THEN
       ! yyVisit1 (yyt);!
    END;
    @ (void) printf ("Stacksize %d\n", (int) & xxHigh - xxStack);@
    !}!
      END;
    !!
    FOR n := 1 TO MaxVisit DO
       !static void yyVisit! WN (n); !!
       !# if defined __STDC__ | defined __cplusplus!
       ! (register ! WI (itTree); ! yyt)!
       !# else!
       ! (yyt) register ! WI (itTree); ! yyt;!
       !# endif!
       !{!
       WriteLine (EvalCodes^.Codes.LocalLine);
       WriteText (f, EvalCodes^.Codes.Local);
       Node := Modules;
       WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
          WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
          Node := Node^.Module.Next;
       END;
      IF IsElement (ORD ('9'), Options) THEN
       ! char xxLow;!
       ! xxStack = Min (xxStack, (int) & xxLow);!
      END;
       !!
       ! switch (yyt->Kind) {!
       IF cOAG IN GrammarClass THEN        (* generate evaluator    *)
          ForallClasses (Classes, GenEvaluator);
       END;
       ! default: ;!
      IF IsElement (ORD ('Z'), Options) THEN
       !  yyVisitParent (yyt);!
      END;
       ! }!
       !}!
       !!
    END;
    !void Begin! WI (EvalName); ! ()!
    !{!
    WriteLine (EvalCodes^.Codes.BeginLine);
    WriteText (f, EvalCodes^.Codes.Begin);
    Node := Modules;
    WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.BeginLine);
       WriteText (f, Node^.Module.EvalCodes^.Codes.Begin);
       Node := Node^.Module.Next;
    END;
    !}!
    !!
    !void Close! WI (EvalName); ! ()!
    !{!
    WriteLine (EvalCodes^.Codes.CloseLine);
    WriteText (f, EvalCodes^.Codes.Close);
    Node := Modules;
    WHILE Node^.Kind = Tree.Module DO
       WriteLine (Node^.Module.EvalCodes^.Codes.CloseLine);
       WriteText (f, Node^.Module.EvalCodes^.Codes.Close);
       Node := Node^.Module.Next;
    END;
    !}!
}; .


PROCEDURE TypeName (t: Tree)

Class (..) :-
    NoCodeClass * Properties = {{}};
    Trace IN Properties;
    @"@ WI (Name); @",@
    .

PROCEDURE GenEvaluator (t: Tree)

Class (..) :-
    NoCodeClass * Properties = {{}};
{    IF (Generated = InstCount) OR (Visits < n) THEN RETURN; END;
    !!
    !case k! WI (Name); !:!
    Class := t;
    LOOP
       IF Generated = InstCount THEN EXIT; END;
       INC (Generated);
       WITH Instance^ [Instance^ [Generated].Order] DO
          IF (Left IN Properties) AND (Attribute^.Child.Partition > n) THEN
             DEC (Generated); EXIT;
          END;
          IF ({Inherited, Right, First} <= Properties) AND NOT (Virtual IN Properties) THEN
      IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
         @yyWriteEval (yyt, "@ WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); @");@
         IF Action # ADR (Action) THEN GenEvaluator (Action); END; !!
         IF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
            !write! WI (itTree);
            ! (yyt->! WI (Name); !.! WI (Selector^.Child.Name);
            !->! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !)!
         ELSE
            !write! WI (Attribute^.Child.Type);
            ! (yyt->! WI (Name); !.! WI (Selector^.Child.Name);
            !->! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !) yyWriteNl ();!
         END;
      ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
         @yyWriteEval (yyt, "@ WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); @");@
         IF Action # ADR (Action) THEN GenEvaluator (Action); END;
      ELSE
         IF Action # ADR (Action) THEN GenEvaluator (Action); END;
      END;
          END;
          IF ({Synthesized, Left, First} <= Properties) AND ({Dummy, Virtual} * Properties = {}) THEN
      IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
         @yyWriteEval (yyt, "@ WI (Attribute^.Child.Name); @");@
         IF Action # ADR (Action) THEN GenEvaluator (Action); END; !!
         IF Test IN Properties THEN
            !writebool (yyb) yyWriteNl ();!
         ELSIF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
            !write! WI (itTree);
            ! (yyt->! WI (Name); !.! WI (Attribute^.Child.Name); !)!
         ELSE
            !write! WI (Attribute^.Child.Type);
            ! (yyt->! WI (Name); !.! WI (Attribute^.Child.Name); !) yyWriteNl ();!
         END;
      ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
         @yyWriteEval (yyt, "@ WI (Attribute^.Child.Name); @");@
         IF Action # ADR (Action) THEN GenEvaluator (Action); END;
      ELSE
         IF Action # ADR (Action) THEN GenEvaluator (Action); END;
      END;
          END;
          IF ({Synthesized, Right, First} <= Properties) AND
         (Attribute^.Child.Partition <= Selector^.Child.Class^.Class.Visits) THEN
      IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
         @yyWriteVisit (yyt, "@ WI (Selector^.Child.Name); ! !
         WN (Attribute^.Child.Partition); @");@
      END;
         !yyVisit! WN (Attribute^.Child.Partition);
         ! (yyt->! WI (Name); !.! WI (Selector^.Child.Name); !);!
          END;
       END;
    END;
      IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
    !yyVisitParent (yyt);!
      END;
    !break;!
}; .
Assign (..) :- {
    WriteLine (Pos);
    GenEvaluator (Results); !=! GenEvaluator (Arguments); !;!
}; .
Copy (..) :- {
    WriteLine (Pos);
    GenEvaluator (Results); !=! GenEvaluator (Arguments); !;!
}; .
TargetCode (..) :- {
    WriteLine (Pos);
    GenEvaluator (Code); !!
}; .
Check (..) :- {
    WriteLine (Pos);
    IF Condition # NoTree THEN
       @if (! (@
      IF IsElement (ORD ('X'), Options) THEN
       !yyb = !
      END;
       GenEvaluator (Condition); !)) {! GenEvaluator (Statement); !; }!
       IF Actions^.Kind = Tree.Check THEN
          !else!
          GenEvaluator (Actions);
       END;
    ELSE
      IF IsElement (ORD ('X'), Options) THEN
       !yyb = false; !
      END;
       GenEvaluator (Statement); !;!
       GenEvaluator (Actions);
    END;
}; .
Designator (..) :- {
    Attr := IdentifyAttribute (Class, Selector);
    IF Attr # NoTree THEN
       ChildsClass := Attr^.Child.Class;
       Attr := IdentifyAttribute (ChildsClass, Attribute);
       IF NOT (Virtual IN Attr^.Attribute.Properties) THEN
          !yyt->! WI (Class^.Class.Name); !.! WI (Selector); !->!
          WI (ChildsClass^.Class.Name); !.! WI (Attribute);
       END;
    ELSE
       WI (Selector); !:! WI (Attribute);
    END;
    GenEvaluator (Next);
}; .
Ident (..) :- {
    Attr := IdentifyAttribute (Class, Attribute);
    IF Attr # NoTree THEN
       IF NOT (Virtual IN Attr^.Attribute.Properties) THEN
          !yyt->! WI (Class^.Class.Name); !.! WI (Attribute);
       END;
    ELSE
       WI (Attribute);
    END;
    GenEvaluator (Next);
}; .
Remote (..) :-
   TheClass: Class; k: INTEGER;
   TheClass := IdentifyClass (TreeRoot^.Ag.Classes, Type);
{  IF TheClass # NoTree THEN
      Attr := IdentifyAttribute (TheClass, Attribute);
      IF Attr # NoTree THEN
     WITH Attr^.Attribute DO
        k := ToBit0 (TheClass, AttrIndex);
        IF Synthesized IN Properties THEN
           !REMOTE_SYN (yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !, yyS! WN (k); !, !
           GenEvaluator (Designators); !, ! WI (t^.Remote.Type); !, ! WI (Attribute); !)!
        ELSIF Inherited IN Properties THEN
           !REMOTE_INH (yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !, ! WN (k); !, !
           GenEvaluator (Designators); !, ! WI (t^.Remote.Type); !, ! WI (Attribute); !)!
        ELSE
           GenEvaluator (Designators); !->! WI (t^.Remote.Type); !.! WI (Attribute);
        END;
     END;
      END;
   END;
   GenEvaluator (Next);
}; .
Any (..) :- {
    WriteString (f, Code);
    GenEvaluator (Next);
}; .
Anys (..) :- {
    GenEvaluator (Layouts);
    GenEvaluator (Next);
}; .
LayoutAny (..) :- {
    WriteString (f, Code);
    GenEvaluator (Next);
}; .